COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	REQUIRE "DPYSYS.HDR[1,PDQ]" SOURCE_FILE
C00004 00003	α XGP and DD character sizes are incompatible
C00006 00004	INTEGER PROC FLOOR(VALUE INTEGER X, SIZE)
C00008 00005	PROC TEXT(VALUE STRING STR VALUE INTEGER X, Y)
C00010 00006	PROC SHADEIN(VALUE INTEGER X, Y, SLOPE)
C00012 ENDMK
C⊗;
REQUIRE "DPYSYS.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "IODEFS.SAI[SEC,RCP]" SOURCE_FILE;

INTEGER ARRAY PLOTCOM[1:1000];

PROC CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
α Outputs display buffer BUFR to disk file FILE in a format
readable by the Nealy Calcomp plotter program PLTVEC, and by
the Quam Video Synthesizer program MIRTOP;
IF FILE THEN
BEGIN	INTEGER DSIZ,CCCHN;
	OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
	ENTER(CCCHN,FILE&".GRF",0);
	DPYPARS;DSIZ←BUFR[2]+3;
	ARRYOUT(CCCHN,BUFR[1],DSIZ);
	RELEASE(CCCHN);
END "CALCOMP";

PROC DISPLAY(VALUE STRING PFILE);
	BEGIN
	OUTSTR("This display will last for a few seconds" ↓);
	IF PFILE THEN CALCOMP(PFILE, PLOTCOM);
	FOR I ← 1 TIL 2 DO DPYOUT(0);
	END;
α XGP and DD character sizes are incompatible;
INTEGER CHAR_SIZE, CHAR_X, CHAR_Y;

PROC CHAR_INIT(VALUE INTEGER SIZE);
	BEGIN
	CHAR_SIZE ← SIZE;
	DPYBIG(CHAR_SIZE);
	IF GET_A_STRING("For XGP [Y,N]") = "Y" THEN
		BEGIN
		CHAR_X ← CASE SIZE OF (0,  5,  9,  9, 18, 23, 36, 45);
		CHAR_Y ← CHAR_X + 2;
		END
	ELSE	BEGIN
		CHAR_X ← CASE SIZE OF (0, 10, 15, 17, 20, 30, 40, 60);
		CHAR_Y ← CHAR_X + 2;
		END;
	BLANKS ← "                              ";
	SETFORMAT(0,1);
	END;

α DD raster values;
INTEGER LEFT, BOTTOM, WIDTH, HEIGHT;

PROC SCREEN_INIT(VALUE INTEGER VCAPS, CAPS);
	BEGIN
	LEFT ← -500;
	BOTTOM ← -500;
	WIDTH ← 1000;
	HEIGHT ← 800;
	LEFT ← LEFT + VCAPS * CHAR_X;
	BOTTOM ← BOTTOM + CAPS * CHAR_Y;
	WIDTH ← WIDTH - VCAPS * CHAR_X;
	HEIGHT ← HEIGHT - CAPS * CHAR_Y;
	END;

α Arbitrary input values;
INTEGER MIN_X, MAX_X, MIN_Y, MAX_Y, X_DIF, Y_DIF;

INTEGER PROC DX_SCALE(VALUE INTEGER X);
	RETURN(X * WIDTH DIV X_DIF);
INTEGER PROC DY_SCALE(VALUE INTEGER Y);
	RETURN(Y * HEIGHT DIV Y_DIF);
INTEGER PROC X_SCALE(VALUE INTEGER X);
	RETURN(DX_SCALE(X - MIN_X) + LEFT);
INTEGER PROC Y_SCALE(VALUE INTEGER Y);
	RETURN(DY_SCALE(Y - MIN_Y) + BOTTOM);
INTEGER PROC FLOOR(VALUE INTEGER X, SIZE);
	RETURN((X + 180 * SIZE) DIV SIZE * SIZE - 180 * SIZE);

PROC X_AXIS;
	BEGIN
	INTEGER LINES, INTERVAL, NEXT_MARK;
	LINES ← BOTTOM - 2 * CHAR_Y;
	X_DIF ← MAX_X - MIN_X;
	INTERVAL ← X_DIF DIV 8;
	INTERVAL ← GET_AN_INT("X-AXIS INTERVAL - NEAR" ∂ CVS(INTERVAL));
	MIN_X ← FLOOR(MIN_X, INTERVAL);
	MAX_X ← -FLOOR(-MAX_X, INTERVAL);
	X_DIF ← MAX_X - MIN_X;
	NEXT_MARK ← MIN_X;
	WHILE NEXT_MARK ≤ MAX_X DO
		BEGIN
		AIVECT(X_SCALE(NEXT_MARK) - CHAR_X, LINES);
		DPYSST(CVS(NEXT_MARK));
		AIVECT(X_SCALE(NEXT_MARK), BOTTOM - CHAR_Y);
		RVECT(0, 2 * CHAR_Y);
		NEXT_MARK ← NEXT_MARK + INTERVAL;
		END;
	END;

PROC Y_AXIS;
	BEGIN
	INTEGER LINES, INTERVAL, NEXT_MARK;
	LINES ← LEFT - 4 * CHAR_X;
	Y_DIF ← MAX_Y - MIN_Y;
	INTERVAL ← Y_DIF DIV 8;
	INTERVAL ← GET_AN_INT("Y-AXIS INTERVAL - NEAR" ∂ CVS(INTERVAL));
	MIN_Y ← FLOOR(MIN_Y, INTERVAL);
	MAX_Y ← -FLOOR(-MAX_Y, INTERVAL);
	Y_DIF ← MAX_Y - MIN_Y;
	NEXT_MARK ← MIN_Y;
	WHILE NEXT_MARK ≤ MAX_Y DO
		BEGIN
		AIVECT(LINES, Y_SCALE(NEXT_MARK));
		DPYSST(CVS(NEXT_MARK));
		AIVECT(LEFT - CHAR_X, Y_SCALE(NEXT_MARK));
		RVECT(2 * CHAR_X, 0);
		NEXT_MARK ← NEXT_MARK + INTERVAL;
		END;
	END;
PROC TEXT(VALUE STRING STR; VALUE INTEGER X, Y);
	BEGIN
	AIVECT(X_SCALE(X), Y_SCALE(Y));
	DPYSST(STR);
	END;

PROC CAPTION(VALUE STRING STR; VALUE INTEGER FROM, TO, LINES);
	IF (FROM ← FROM MAX MIN_X) < (TO ← TO MIN MAX_X) THEN
	BEGIN
	AIVECT((X_SCALE(FROM) + X_SCALE(TO) - LN(STR) * CHAR_X) DIV 2,
		BOTTOM - LINES * CHAR_Y);
	DPYSST(STR);
	END;

PROC VERT_CAPTION(VALUE STRING STR; VALUE INTEGER LINES, FROM, TO);
	IF (FROM ← FROM MIN MAX_Y) > (TO ← TO MAX MIN_Y) THEN
	BEGIN
	LINES ← LEFT - LINES * CHAR_X;
	FROM ← (Y_SCALE(FROM) + Y_SCALE(TO) + LN(STR) * CHAR_Y) DIV 2;
	FOR I ← 1 TIL LN(STR) DO
		BEGIN
		AIVECT(LINES, FROM - I * CHAR_Y);
		DPYSST(STR[I FOR 1]);
		END;
	END;

PROC LINE(VALUE INTEGER X1, Y1, X2, Y2);
	BEGIN
	AIVECT(X_SCALE(X1), Y_SCALE(Y1));
	AVECT(X_SCALE(X2), Y_SCALE(Y2));
	END;

PROC STREET(VALUE INTEGER FX, FY, TX, TY, NX, NY; VALUE STRING ST);
	BEGIN
	LINE(FX, FY, TX, TY);
	TEXT(ST, NX, NY);
	END;
PROC SHADEIN(VALUE INTEGER X, Y, SLOPE);
	BEGIN
	INTEGER HALFX1, HALFX2, START;
	HALFX1 ← X DIV 2;
	HALFX2 ← X - HALFX1;
	RIVECT(HALFX1, 0);
	START ← (IF SLOPE = 1 THEN HALFX2 ELSE HALFX1) MIN Y;
	RVECT(SLOPE * START, START);
	RIVECT(- SLOPE * ((IF SLOPE = 1 THEN HALFX1 ELSE HALFX2) + START), -START);
	FOR START ← 0 STEP HALFX1 UNTIL  Y - X DO
		BEGIN
		RVECT(SLOPE * X, X);
		RIVECT(- SLOPE * X, -HALFX2);
		END;
	WHILE START < Y DO
		BEGIN
		INTEGER ¬hIS;
		THIS ← Y - START;
		RVECT(SLOPE * THIS, THIS);
		RIVECT(- SLOPE * THIS, HALFX1 - THIS);
		START ← START + HALFX1;
		END;
	END;

PROC BOX(VALUE INTEGER X, Y, DX, DY, SHADE);
	BEGIN
	AIVECT(X_SCALE(X), Y_SCALE(Y));
	DX ← DX_SCALE(DX MAX 1);
	DY ← DY_SCALE(DY MAX 1);
	RVECT(0, DY);
	RVECT(DX, 0);
	RVECT(0, - DY);
	RVECT(- DX, 0);
	IF SHADE = 1 OR SHADE = 3 THEN SHADEIN(DX, DY, 1);
	AIVECT(X_SCALE(X), Y_SCALE(Y));
	IF SHADE = 1 OR SHADE = 5 THEN SHADEIN(DX, DY, -1);
	END;